home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / printf / print.bas < prev    next >
Encoding:
BASIC Source File  |  1995-05-09  |  4.2 KB  |  137 lines
  1. 'Print File
  2. ' Prints the specified file. Use in place of SpoolFile
  3. ' Scott Johnston 7-29-94 CIS:72677,1570 MHS:ScottJ@Alta
  4. DefInt A-Z
  5.  
  6. Type DOCINFO
  7.     cbSize As Integer
  8.     lpszDocName As Long
  9.     lpszOutput As Long
  10. End Type
  11.  
  12.  
  13. Declare Function CreateDC Lib "GDI" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, ByVal lpInitData As String) As Integer
  14. Declare Function DeleteDC Lib "GDI" (ByVal hdc As Integer) As Integer
  15. Declare Function Escape Lib "GDI" (ByVal hdc As Integer, ByVal nEscape As Integer, ByVal nCount As Integer, ByVal lplnData As Any, ByVal lpOutData As Any) As Integer
  16. Declare Function StartDoc Lib "GDI" (ByVal hdc As Integer, lpdi As DOCINFO) As Integer
  17. Declare Function EndDocAPI Lib "GDI" Alias "EndDoc" (ByVal hdc As Integer) As Integer
  18. Declare Function GetProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer) As Integer
  19. Declare Function lstrcpy Lib "Kernel" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
  20.  
  21.  
  22. Global Const QUERYESCSUPPORT = 8
  23. Global Const PASSTHROUGH = 19
  24.  
  25. Sub GetDefPrinter (printDriver$, printDevice$, printOut$)
  26.     ErrMsg$ = "Unable to determine default printer."
  27.     printerINI$ = Space$(256)
  28.     r% = GetProfileString("Windows", "device", "None", printerINI$, Len(printerINI$))
  29.     printerINI$ = Left$(printerINI$, InStr(printerINI$, Chr$(0)) - 1)
  30.     If printerINI$ <> "None" Then
  31.     CPos = InStr(printerINI$, ",")
  32.     If CPos > 0 Then
  33.         printDevice$ = Left$(printerINI$, CPos - 1) + Chr$(0)
  34.         printerINI$ = Mid$(printerINI$, CPos + 1)
  35.         CPos = InStr(printerINI$, ",")
  36.         If CPos > 0 Then
  37.         printDriver$ = Left$(printerINI$, CPos - 1) + Chr$(0)
  38.         printOut$ = Mid$(printerINI$, CPos + 1) + Chr$(0)
  39.         Else
  40.         MsgBox ErrMsg$
  41.         printerDriver$ = ""
  42.         End If
  43.     Else
  44.         MsgBox ErrMsg$
  45.         printerDriver$ = ""
  46.     End If
  47.     Else
  48.     MsgBox ErrMsg$
  49.     printerDriver$ = ""
  50.     End If
  51.  
  52. End Sub
  53.  
  54. Function PrintFile (FileName$) As Integer
  55.     'prints the specified file to the default printer
  56.     'returns 1 if successful, 0 if not
  57.  
  58.     ret% = 1
  59.     GetDefPrinter printDriver$, printDevice$, printOut$
  60.     If Len(printDriver$) > 0 Then
  61.     hpDC = CreateDC(printDriver$, printDevice$, printOut$, "")
  62.     If hpDC <> 0 Then
  63.         strPASS$ = Chr$(PASSTHROUGH And &HFF) + Chr$(PASSTHROUGH \ 256)
  64.         rQuery% = Escape(hpDC, QUERYESCSUPPORT, 2, strPASS$, "")
  65.         If rQuery% <> 0 Then
  66.         ret% = SendFile(hpDC, FileName$)
  67.         Else
  68.         MsgBox printDevice$ + " does not support the PASSTHROUGH escape."
  69.         ret% = 0
  70.         End If
  71.         rDelDC% = DeleteDC(hpDC)
  72.         If rDelDC% = 0 Then
  73.         MsgBox "Error deleting DC."
  74.         ret% = 0
  75.         End If
  76.     Else
  77.         MsgBox "Unable to create DC."
  78.         ret% = 0
  79.     End If
  80.     End If
  81.     PrintFile = ret%
  82. End Function
  83.  
  84. Function SendFile (hpDC, FileName$)
  85.     'actually passthrough the file to the printerDC
  86.     'returns 1 if successful, 0 if not
  87.     ret% = 1
  88.     Dim dInfo As DOCINFO
  89.     FileNum = FreeFile
  90.     Open FileName$ For Binary Access Read Shared As FileNum
  91.     If Len(FileNum) > 0 Then
  92.     bSize% = 4096
  93.     CurrPos# = 1
  94.     DocName$ = FileName$ + Chr$(0)
  95.     If Len(DocName$) > 32 Then
  96.         DocName$ = Left$(DocName$, 31) + Chr$(0)
  97.     End If
  98.     dInfo.lpszDocName = lstrcpy(DocName$, DocName$)
  99.     dInfo.lpszOutput = 0
  100.     dInfo.cbSize = Len(DocName$)
  101.     rStart% = StartDoc(hpDC, dInfo)
  102.     If rStart% > 0 Then
  103.         Do
  104.         If CurrPos# + bSize% > LOF(FileNum) Then
  105.             bSize% = LOF(FileNum) - CurrPos# + 1
  106.         End If
  107.         Buffer$ = Space$(bSize%)
  108.         Get #FileNum, CurrPos#, Buffer$
  109.         DataLen$ = Chr$(bSize% And &HFF) + Chr$(bSize% \ 256)
  110.         printData$ = DataLen$ + Buffer$
  111.         rPrint% = Escape(hpDC, PASSTHROUGH, 0, printData$, "")
  112.         If rPrint% <= 0 Then
  113.             MsgBox "Error in PASSTHROUGH Escape."
  114.             ret% = 0
  115.             Exit Do
  116.         End If
  117.         CurrPos# = CurrPos# + bSize%
  118.         Loop Until CurrPos# > LOF(FileNum)
  119.         If rPrint% > 0 Then
  120.         rEnd% = EndDocAPI(hpDC)
  121.         If rEnd% < 0 Then
  122.             MsgBox "Error in EndDoc."
  123.             ret% = 0
  124.         End If
  125.         End If
  126.     Else
  127.         MsgBox "Error in StartDoc."
  128.         ret% = 0
  129.     End If
  130.     Else
  131.     MsgBox "File not found"
  132.     ret = 0
  133.     End If
  134.     SendFile = ret%
  135. End Function
  136.  
  137.